COMMENT ⊗   VALID 00008 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	TITLE DCSTAT  Datacomputer status
C00003 00003	 MACRO DEFINITIONS
C00006 00004	 SYSTEM DEPENDENT DEFINITIONS
C00007 00005	 ***PROGRAM***
C00008 00006	 ***DATACOMPUTER INTERFACE ROUTINES***
C00010 00007	 ***SYSTEM ROUTINES***
C00017 00008	 ***DATA***
C00018 ENDMK
C⊗;
TITLE DCSTAT  Datacomputer status

; Bugs/gripes to Bug-DFTP@MIT-AI

; ***DEFINITIONS***

	DCHOST==37
	DCSOKT==703

; REGISTER DEFINITIONS

	R1==1
	R2==2
	R3==3
	R4==4
	R5==5
	R6==6
	R7==7
	R10==10
	R11==11
	R12==12
	R13==13
	R14==14
	R15==15
	R16==16
	R17==17

;	(SCRATCH REGISTERS)
	REG1==1
	REG2==2
	REG3==3
	REG4==4

;	(COMMONLY USED REGISTERS)
	IOREG==R5
	BPREG==R6
	FLAG==R15
	UTIL==R16
	STAK==R17
; MACRO DEFINITIONS

	SALL

DEFINE	BEGINR(SAVLST,%RETN)
<	..SAVL==0
	..SAVC==0
	IFIDN <SAVLST><ALL>,<..SAVL==77777>
	IFDIF <SAVLST><ALL>,<
		IRP SAVLST,<
			IFG <SAVLST>-20,<!!
				PRINTX SAVLST NOT A REGISTER>
			IFLE <SAVLST>-20,<
				IFN ..SAVL&1←SAVLST,<!!
					PRINTX SAVLST SAVED TWICE>
				..SAVL==..SAVL!1←SAVLST
				..SAVC==..SAVC+1>>>
	IFN ..SAVL,<
		..REG==17
		REPEAT 20,<
			IFN ..SAVL&1←..REG,<PUSH STAK,..REG>
			..REG==..REG-1>>
	DEFINE	.%RETN <%RETN>	; UNIQUE LOCATION FOR RETURN AND ENDR
	DEFINE	.%RETL <%RETN':!>
	..SFLG==0		; LARGEST SKIP RETURN
>

; IF RETURN CAN'T BE POPJ, THEN IT ASSEMBLES AS JRST TO ENDR CODE
;   JRST TO .%RETN FOR NOSKIP RETURN, .%RETN-N FOR SKIP RETURN
;   ..SFLG SIGNALS THAT SKIP CODE MUST BE ASSEMBLED IN ENDR
DEFINE	RETURN(SK,N)
<<IFB <SK>,<<IFE ..SAVC,<POPJ STAK,.%RETN>>+<IFN ..SAVC,<JRST .%RETN>>>>+<IFIDN <SK><SKIP>,<<IFG N-..SFLG,<..SFLG==N>>*0+<JRST .%RETN-N>>>>

; RETURN FOR USE WITH CONDITIONAL JUMPS
DEFINE	RETN(N)
<<IFB <N>,<<IFE ..SAVC,<.%RETN>>+<IFN ..SAVC,<.%RETN>>>>+<IFNB <N>,<<IFG N-..SFLG,<..SFLG==N>>*0+<.%RETN-N>>>>

; ENDR DECRIMENTS STAK, RESTORES REGS, RETURNS (POSSIBLY SKIPPING)
DEFINE	ENDR(SK,N)
<	IFB <SK>,<..N==0>
	IFIDN <SK><SKIP>,<..N==N
		IFG <..N-..SFLG>,<..SFLG==..N>>
	IFN <..SFLG>,<IFN <..N-..SFLG>,<JRST .%RETN-..N>
		REPEAT ..SFLG,<
			AOS -..SAVC(STAK)>>
	.%RETL
	..REG==0
	REPEAT 20,<
		IFN ..SAVL&1←..REG,<POP STAK,..REG
			..SAVL==..SAVL-1←..REG>
		..REG==..REG+1>
	POPJ STAK,>

DEFINE	CALLR(ROUTIN)
<	PUSHJ	STAK,ROUTIN>
; SYSTEM DEPENDENT DEFINITIONS

IFNDEF TTCALL,<OPDEF TTCALL [TTYUUO]>

	SIZBLK==200

	DCCHAN==1

DEFINE	TBOUT(REG)
<	TTCALL	1,REG>
DEFINE	TSOUT(STRING)
<	IRP STRING
<	TTCALL	3,STRING>>

DEFINE	DCBIN(REG)
<	SKIPG	DCIBUF+2
	CALLR	NUTMI
	SOS	DCIBUF+2
	ILDB	REG,DCIBUF+1
	JUMPE REG,.-4>
; ***PROGRAM***

DCSTAT:	JFCL
	RESET
	MOVE	STAK,[IOWD STSIZ,STBEG]
	CALLR	S$INIT
	SKIPE	FLAGDD
	 JRST	QUIT
HEADER:	CALLR	RENPRE
	CALLR	RENLIN
	CAMN	IOREG,[ASCII/.J900/]
	 JRST	QUITQ
	CAME	IOREG,[ASCII/.I280/]
	 JRST	HEADER
	JRST	TRAILR
STATUS:	DCBIN	<IOREG>
	TBOUT	<IOREG>
	CAIE	IOREG,12
	 JRST	STATUS
TRAILR:	DCBIN	<IOREG>
	CAIE	IOREG," "
	 JRST	FINISH
	MOVEI	IOREG,"]"
	TBOUT	<IOREG>
	MOVEI	IOREG," "
	TBOUT	<IOREG>
	JRST	STATUS
FINISH:	CALLR	RENLIN
	JRST	QUIT
; ***DATACOMPUTER INTERFACE ROUTINES***

; RENLIN -- REQUEST END: PROCEED TO NEW LINE
;
RENLIN:	BEGINR	<IOREG>
RENLNL:	DCBIN	<IOREG>
	CAIE	IOREG,12
	 JRST	RENLNL
	ENDR

; RENLIP -- REQUEST END: PROCEED TO NEW LINE, PRINT MESSAGE
;
RENLIP:	BEGINR	<IOREG>
	SKIPN	FLAGDD
	 JRST	RENLPF
RENLPL:	DCBIN	<IOREG>
	CAIE	IOREG,12
	 JRST	RENLPL
	RETURN
RENLPF:	DCBIN	<IOREG>
	CAIN	IOREG,12
	 RETURN
	CAIE	IOREG,11
	 JRST	RENLPF
	MOVEI	IOREG," "
	TBOUT	<IOREG>
	MOVEI	IOREG,"("
RENLPP:	TBOUT	<IOREG>
	DCBIN	<IOREG>
	CAIE	IOREG,15
	 JRST	RENLPP
	DCBIN	<IOREG>
	MOVEI	IOREG,")"
	TBOUT	<IOREG>
	TSOUT	<CRLF>
	ENDR

; RENPRE -- REQUEST END: RETURN ERROR PREFIX (ASSUMES RENLIN)
;   OUT: IOREG -- ASCII PREFIX (5 BYTES)
;
RENPRE:	BEGINR	<BPREG,UTIL,FLAG>
RENPRP:	SETZ	IOREG,
	MOVE	BPREG,[440700,,IOREG]
	MOVEI	FLAG,5
RENPRL:	DCBIN	<UTIL>
	CAIN	UTIL,15
	 JRST	RENPRL
	CAIN	UTIL,12
	 JRST	RENPRL
	IDPB	UTIL,BPREG
	SOJG	FLAG,RENPRL
	LDB	UTIL,[350700,,IOREG]
	CAIN	UTIL,"?"
	 JRST	DEATH
	CAIE	UTIL,"!"
	 RETURN
	CALLR	RENLIP
	JRST	RENPRP
	ENDR

; DEATH -- FATAL DATACOMPUTER ERROR (? MESSAGE)
;
DEATH:	CALLR	RENLIP
	TSOUT	<[ASCIZ/ ?? Fatal Datacomputer error ??/],CRLF>
	EXIT
; ***SYSTEM ROUTINES***
;SYSTEM INITIALIZATION
;
S$INIT:	BEGINR
	MOVE	[SIXBIT/DCSTAT/]
	SETNAM
	CALLR	ICP
	ENDR

; SAIL ICP:			THIS ROUTINE WAS SWIPED OFF OF ANOTHER
;				SAIL PROGRAM THAT WORKED

; POSITIONS IN MTAPE BLOCK

STLOC==1	; STATUS BITS RETURNED HERE
LSLOC==2	; LOCAL SOCKET
WFLOC==3	; WAIT FLAG
BSLOC==4	; BYTE SIZE LOCATION
FSLOC==5	; FOREIGN SOCKET
HLOC==6		; HOST NUMBER

ERRBTS==763600	; I/O ERROR BITS

ICP:	BEGINR
	PJOB REG2,		; GET JOB #
	TIMER REG1,		; GET A "RANDOM NUMBER"
	ANDI REG1,377770	; BUT MAKE IT A HALFWORD
	MOVSS REG4,REG2		; RECEIVE SOCKET
	ADDI REG2,(REG1)	; BARFUCIOUS SAIL CROCK...
	ADDI REG4,(REG1)	; TO INSURE WE WIN OKAY...
	ADDI REG4,1		; TRANSMIT SOCKET
	INIT DCCHAN,17
	SIXBIT /IMP/
	0
	 JRST ICPLUZ
	SETZM CONECB
	MOVEM REG2,CONECB+LSLOC
	MOVEI REG3,DCHOST
	MOVEM REG3,CONECB+HLOC
	SETOM CONECB+WFLOC
	MOVEI REG3,40
	MOVEM REG3,CONECB+BSLOC
	MOVEI REG3,DCSOKT
	MOVEM REG3,CONECB+FSLOC
	MTAPE DCCHAN,[
		↑D15
		BYTE (6) 2,24,0,12,12
		]		; TIME OUT CLS, RFNM, RFC, AND INPUT
	MTAPE DCCHAN,CONECB
	STATZ DCCHAN,ERRBTS
	 JRST ICPLUZ		; NO CONNECTION TO LOGGER
	INPUT DCCHAN,[IOWD 1,FRS#
		0]
	STATZ DCCHAN,ERRBTS
	 JRST ICPLUZ		; GOT LOGGER BUT DIDN'T GET SOCKET FROM HIM
	MOVE REG3,FRS
	LSH REG3,-4
	MOVEM REG3,FRS
	ADDI REG3,1
	MOVEM REG3,FSS#
	ADDI REG2,2
	MOVEM REG2,LRS#
	ADDI REG4,2
	MOVEM REG4,LSS#
	MOVE REG1,CONECB+LSLOC
	MOVEM REG1,TERBLK+LSLOC
	MTAPE DCCHAN,TERBLK	; RELEASE LOGGER
	INIT DCCHAN,1
	SIXBIT /IMP/
	XWD DCOBUF,DCIBUF
	 JRST ICPLUZ
	MTAPE DCCHAN,[
		↑D15
		BYTE (6) 5,24,0,12,0
		]		; TIME OUT CLS, RFNM, AND RFC
	MOVEI REG1,↑D8
	DPB REG1,[POINT 6,DCIBUF+1,11]
	DPB REG1,[POINT 6,DCOBUF+1,11]
	MOVEM REG2,CONECB+LSLOC
	MOVEI REG3,DCHOST
	MOVEM REG3,CONECB+HLOC
	SETZM CONECB+WFLOC
	MOVEI REG3,↑D8
	MOVEM REG3,CONECB+BSLOC
	MOVE REG3,FSS
	MOVEM REG3,CONECB+FSLOC
	MTAPE DCCHAN,CONECB
	MOVE REG1,CONECB+STLOC
	TRNN REG1,-1
	 STATZ DCCHAN,ERRBTS
	  JRST ICPLUZ		; CAN'T CONNECT TO RECEIVE SIDE
	CALLR CLSCHK		; SEE IF WE ARE REALLY OPEN
	 JRST ICPLUZ
	AOS CONECB+LSLOC
	SOS CONECB+FSLOC
	MOVEI REG3,↑D8
	MOVEM REG3,CONECB+BSLOC
	MTAPE DCCHAN,CONECB
	MOVE REG1,CONECB+STLOC
	TRNN REG1,-1
	 STATZ DCCHAN,ERRBTS
	  JRST ICPLUZ		; CAN'T CONNECT TO SEND SIDE
	CALLR CLSCHK
	 JRST ICPLUZ
	MOVEI REG3,4
	MOVEM REG3,CONECB
	MTAPE DCCHAN,CONECB
	MOVE REG1,CONECB+STLOC
	TLC REG1,300000
	TLCN REG1,300000
	 TLNE REG1,060000
	  JRST ICPLUZ
	STATZ DCCHAN,ERRBTS
	 JRST ICPLUZ
	SOS CONECB+LSLOC
	CALLR CLSCHK
	 JRST ICPLUZ
	MTAPE DCCHAN,CONECB
	MOVE REG1,CONECB+STLOC
	TLC REG1,300000
	TLCN REG1,300000
	 TLNE REG1,060000
	  JRST ICPLUZ
	STATZ DCCHAN,ERRBTS
	 JRST ICPLUZ		; LOST WHILE WAITING FOR RECEIVE SIDE TO CONNECT
	CALLR CLSCHK
	 JRST ICPLUZ
	RETURN

; HERE WHEN CONNECTION FAILS

ICPLUZ:	OUTSTR [ASCIZ/? Cannot establish network connection/]
	EXIT
	ENDR

; NETWORK QUIT -- BREAK DATACOMPUTER CONNECTIONS
;
QUIT:	INPUT	DCCHAN,
	STATZ	DCCHAN,20000
	 JRST	QUIT01
	SKIPN	FLAGDD
	 JRST	QUIT
	HRRZ	REG1,DCIBUF
	CALLR	NUTDD
	JRST	QUIT
QUIT01:	RELEAS	DCCHAN,		; RELEASE INPUT/OUTPUT DEVICE
QUIT02:
QUIT03:
QUITQ:	RESET
	EXIT

; NETWORK UTILITY -- MESSAGE INPUT
;
NUTMI:	BEGINR
	IN	DCCHAN,
	 JRST	.+2
	JRST	NETEIT
	SKIPE	FLAGDD
	 CALLR	NUTDD
	ENDR

; NETWORK UTILITY -- DISPLAY DATALANGUAGE
;   IN: REG1 -- POINTER TO BUFFER HEADER
;
NUTDD:	BEGINR	<IOREG,UTIL>
	MOVE REG1,DCIBUF+1
	MOVE UTIL,DCIBUF+2
NUTDDL:	SOJL	UTIL,RETN(0)
	ILDB	IOREG,REG1
	JUMPE	IOREG,NUTDDL
	TTCALL	1,IOREG
	JRST	NUTDDL
	ENDR

; FATAL NETWORK ERROR MESSAGES
;
NETEIT:	TTCALL	3,[ASCIZ/ ?? Input failure (transfer) ??/]
	JRST	QUIT
NETEOT:	TTCALL	3,[ASCIZ/ ?? Output failure (transfer) ??/]
	JRST	QUIT

CLSCHK:	BEGINR
	MTAPE DCCHAN,STTBLK
	MOVE REG1,STTBLK+1
	IOR REG1,STTBLK+2
	STATO DCCHAN,ERRBTS
	 TLNN REG1,060000
	  RETURN SKIP,1
	ENDR
; ***DATA***

	LIT			; LITERALS GO HERE

CRLF:	BYTE	(7)15,12,0,0,0

CONECB:	BLOCK 7
STTBLK:	2
	BLOCK 2
TERBLK:	3
	0
	1
	0
DCIBUF:	BLOCK	3
DCOBUF:	BLOCK	3

; * VARIABLES

FLAGDD:	0

BUFFER:	BLOCK	100

	STSIZ==100
STBEG:	BLOCK	STSIZ


	END	DCSTAT